module Test.QuickCheckText
        --   ( Str(..)
        --   , ranges
        -- 
        --   , number
        --   , short
        --   , showErr
        --   , oneLine
        --   , isOneLine
        --   , bold
        -- 
        --   , newTerminal
        --   , withStdioTerminal
        --   , withNullTerminal
        --   , terminalOutput
        --   , handle
        --   , Terminal
        --   , putTemp
        --   , putPart
        --   , putLine
        --   )
 where

-- ------------------------------------------------------------------------
-- imports

-- no need in Frege
-- import Control.Applicative

-- import System.IO
--   ( hFlush
--   , hPutStr
--   , stdout
--   , stderr
--   , Handle
--   , BufferMode (..)
--   , hGetBuffering
--   , hSetBuffering
--   )

import Data.Monoid
 

--------------------------------------------------------------------------
-- literal string

newtype Str = MkStr String

instance Show Str where
  show (MkStr s) = s

ranges :: (Show a, Integral a) => a -> a -> Str
ranges k n = MkStr (show n' ++ " -- " ++ show (n'+k-1))
 where
  n' = k * (n `div` k)

--------------------------------------------------------------------------
-- formatting

number :: Int -> String -> String
number n s = show n ++ " " ++ s ++ (if n == 1 then "" else "s")

kurz :: Int -> String -> String
kurz n s
  | n < k     = strhead s (n-2-i) ++ ".." ++ strtail s (k-i)
  | otherwise = s
 where
  k = length s
  i = if n >= 5 then 3 else 0

showErr :: Show a => a -> String
showErr = unwords . words . show

oneLine :: String -> String
oneLine = unwords . words

isOneLine :: String -> Bool
isOneLine xs = xs.indexOf '\n' >= 0 -- '\n' `notElem` xs

bold :: String -> String
-- not portable:
--bold s = "\ESC[1m" ++ s ++ "\ESC[0m"
bold s = s -- for now

-- ------------------------------------------------------------------------
-- putting strings

data Terminal
  = MkTerminal (IORef (IO ())) Output Output

data Output
  = Output (String -> IO ()) (IORef String)

newTerminal :: Output -> Output -> IO Terminal
newTerminal out err =
  do ref <- IORef.new (return ())
     return (MkTerminal ref out err)

withBuffering :: IO a -> IO a
withBuffering = id              -- not possible on java.io.Writer
-- withBuffering action = do
--   mode <- hGetBuffering stderr
--   -- By default stderr is unbuffered.  This is very slow, hence we explicitly
--   -- enable line buffering.
--   hSetBuffering stderr LineBuffering
--   action `finally` hSetBuffering stderr mode

withStdioTerminal :: (Terminal -> IO a) -> IO a
withStdioTerminal action = do
  out <- output (handle stdout)
  err <- output (handle stderr)
  withBuffering (newTerminal out err >>= action)

withNullTerminal :: (Terminal -> IO a) -> IO a
withNullTerminal action = do
  out <- output (const (return ()))
  err <- output (const (return ()))
  newTerminal out err >>= action

terminalOutput :: Terminal -> IO String
terminalOutput (MkTerminal _ out _) = get out

type Handle = MutableIO PrintWriter
hPutStr = Handle.print
hFlush  = Flushable.flush

handle :: Handle -> String -> IO ()
handle h s = do
  hPutStr h s
  hFlush h

output :: (String -> IO ()) -> IO Output
output f = do
  r <- IORef.new ""
  return (Output f r)

put :: Output -> String -> IO ()
put (Output f r) s = do
  f s
  IORef.modify r (++ s)

get :: Output -> IO String
get (Output _ r) = IORef.get r

flush :: Terminal -> IO ()
flush (MkTerminal ref _ _) =
  do io <- IORef.get ref
     IORef.put ref (return ())
     io

postpone :: Terminal -> IO () -> IO ()
postpone (MkTerminal ref _ _) io' =
  do io <- IORef.get ref
     IORef.put ref (io >> io')

putPart, putTemp, putLine :: Terminal -> String -> IO ()
putPart (tm@MkTerminal _ out _) s =
  do flush tm
     put out s

putTemp (tm@MkTerminal _ _ err) s =
  do flush tm
     put err (s ++ s.length `mtimes` "\b")
     postpone tm $
       put err ( s.length `mtimes` " "
              ++ s.length `mtimes` "\b"
               )

putLine (tm@MkTerminal _ out _) s =
  do flush tm
     put out (s ++ "\n")

-- ------------------------------------------------------------------------
-- the end.